home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / wipeab_1 / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-09  |  6.1 KB  |  169 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fest Einfach
  4.    Caption         =   "WIPE A BANNER OVER A BACKGROUND"
  5.    ClientHeight    =   4575
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6450
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   305
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   430
  17.    StartUpPosition =   3  'Windows-Standard
  18.    Begin VB.CheckBox Check1 
  19.       Caption         =   "Transparent"
  20.       Height          =   255
  21.       Left            =   960
  22.       TabIndex        =   5
  23.       Top             =   0
  24.       Width           =   1335
  25.    End
  26.    Begin VB.CommandButton Command1 
  27.       Cancel          =   -1  'True
  28.       Caption         =   "END"
  29.       Height          =   375
  30.       Left            =   0
  31.       TabIndex        =   1
  32.       Top             =   0
  33.       Width           =   855
  34.    End
  35.    Begin VB.Timer Timer1 
  36.       Interval        =   20
  37.       Left            =   4560
  38.       Top             =   360
  39.    End
  40.    Begin VB.PictureBox OutPic 
  41.       ClipControls    =   0   'False
  42.       Height          =   3015
  43.       Left            =   0
  44.       ScaleHeight     =   197
  45.       ScaleMode       =   3  'Pixel
  46.       ScaleWidth      =   197
  47.       TabIndex        =   0
  48.       Top             =   360
  49.       Width           =   3015
  50.    End
  51.    Begin VB.Label Label4 
  52.       Alignment       =   2  'Zentriert
  53.       AutoSize        =   -1  'True
  54.       Caption         =   "NO OPENGL OR DIRECTX NEEDED !  JUST A FEW BITBLIT"
  55.       ForeColor       =   &H0000FFFF&
  56.       Height          =   390
  57.       Left            =   3120
  58.       TabIndex        =   6
  59.       Top             =   0
  60.       Width           =   3255
  61.       WordWrap        =   -1  'True
  62.    End
  63.    Begin VB.Label Label3 
  64.       BackStyle       =   0  'Transparent
  65.       BorderStyle     =   1  'Fest Einfach
  66.       Caption         =   "Cool routine.. Load a picture and create a hdc.(invisible)..  view it in module.bas"
  67.       Height          =   375
  68.       Left            =   0
  69.       TabIndex        =   4
  70.       Top             =   3840
  71.       Width           =   6375
  72.    End
  73.    Begin VB.Label Label2 
  74.       BackStyle       =   0  'Transparent
  75.       BorderStyle     =   1  'Fest Einfach
  76.       Caption         =   "All you need is: one Picture.box a background.bmp , a logo.bmp to scroll and a timer"
  77.       Height          =   255
  78.       Left            =   0
  79.       TabIndex        =   3
  80.       Top             =   3480
  81.       Width           =   6375
  82.    End
  83.    Begin VB.Label Label1 
  84.       AutoSize        =   -1  'True
  85.       Caption         =   "TOTAL FREEWARE   questions and comments to RINGS@Online.de"
  86.       ForeColor       =   &H000000FF&
  87.       Height          =   195
  88.       Left            =   120
  89.       TabIndex        =   2
  90.       Top             =   4320
  91.       Width           =   4950
  92.    End
  93. Attribute VB_Name = "Form1"
  94. Attribute VB_GlobalNameSpace = False
  95. Attribute VB_Creatable = False
  96. Attribute VB_PredeclaredId = True
  97. Attribute VB_Exposed = False
  98. ' Wipe a banner transparently in a picture-Box
  99. ' another INFO for your Proggy
  100. ' based on different routines downloaded from PLANET-SOURCE-CODE.COM
  101. ' There is still more to do
  102. ' This version updated on 8/9/1999
  103. ' No Second-Picture-Box needed !!!
  104. ' coded by Siegfried Rings, RINGS@Online.de
  105. ' FULLY PublicDomain
  106. Option Explicit
  107. Private Sub Command1_Click()
  108. End Sub
  109. Private Sub Timer1_Timer()
  110.  Dim mode As Long
  111.  If Check1.Value = 1 Then mode = SRCAND
  112.  If Check1.Value = 0 Then mode = SRCCOPY
  113.  scrollbanner OutPic, Me, mode
  114. End Sub
  115. Sub scrollbanner(OutputPicture As Control, FMe As Form, mode As Long)
  116. Static DoInitialize As Boolean
  117. Static LogoDC As Long     'The sprite bitmap storage area
  118. Static BackDC As Long       'The background bitmap storage
  119. Static TempDC As Long
  120. Static tmpval As Long
  121. Static angle_x, angle_y, speed, i As Integer
  122. Static MyXPointer, MyYPointer As Integer 'Banner moving in the Box
  123. Dim bmp As Long
  124. Static BannerW, BannerH As Integer
  125. Dim w1, h1 As Integer
  126. If DoInitialize = False Then
  127.  'First time calling , do some init (loading pictures and create's some Hdc
  128.  angle_x = 180 'logo x angle
  129.  angle_y = 60 'logo y angle
  130.  speed = 6    'spin speed
  131.  Call DirectLoadPicture("Banner5.bmp", LogoDC, bmp, BannerW, BannerH, FMe) 'Load Banner-picture and creates LOGODC
  132.  Call DirectLoadPicture("background1.bmp", BackDC, bmp, w1, h1, FMe) 'Load Backgroundpicture and creates BackDC
  133.  OutputPicture.Width = w1
  134.  OutputPicture.Height = h1
  135.  Call DirectLoadPicture("", TempDC, bmp, OutputPicture.Width, OutputPicture.Height, FMe) 'create work area
  136.  DoInitialize = True
  137. End If
  138. 'the Logo moves from left to right
  139. MyXPointer = MyXPointer + 2
  140. If MyXPointer > OutputPicture.Width Then MyXPointer = -BannerW / 2
  141. 'And from top to bottom
  142. MyYPointer = MyYPointer + 1
  143. If MyYPointer > OutputPicture.Height Then MyYPointer = -BannerH
  144. 'now copy Background in temporary bitmap
  145. tmpval = BitBlt(TempDC, 0, 0, OutputPicture.Width, OutputPicture.Height, BackDC, 0, 0, SRCCOPY) 'copy background to stage area
  146. 'there is room for more improvment for SIN-Scroller
  147. For i = 1 To BannerW
  148.  'Copy Banner with sin-effect in temporary background
  149.  tmpval = BitBlt(TempDC, Cos(degtorad(angle_x + i)) * (BannerW / 4.25) + MyXPointer, Sin(degtorad(angle_y + i)) * 10 + 2.5 + MyYPointer, 1, BannerH, LogoDC, i, 0, mode)  ' put spinning logo onto stage area
  150. Next i
  151.         
  152. 'Now copy temporary bitmap to output-Picture-Box
  153. tmpval = BitBlt(OutputPicture.hDC, 0, 0, OutputPicture.Width, OutputPicture.Height, TempDC, 0, 0, SRCCOPY) ' copy stage to PictureBox
  154.         
  155. 'any calculations follows
  156. angle_x = angle_x + speed * 0.5 ' rotate logo x
  157. angle_y = angle_y + speed * 2 ' rotate logo y
  158.        
  159. If angle_x >= 360 Then  ' have we done a full rotation 360o??
  160.   angle_x = 0  ' Yep, reset angle
  161. End If
  162. If angle_x <= -180 Then  ' have we done a full rotation 360o??
  163.   speed = speed * -1
  164. End If
  165. If angle_y >= 360 Then
  166.    angle_y = 0
  167. End If
  168. End Sub
  169.